      SUBROUTINE CIN30  (A,N,INDEX)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE CIN30                                                  C
C         CIN READS THE FIRST N WORDS OF THE STRING, IDENTIFIED         C
C         BY 'INDEX', INTO A(1,N)                                       C
C         IF INDEX.EQ.' ' CIN AND CIN301 PERFORM NO OPERATION.          C
C         IF NO RECORD WITH 'INDEX' IS PRESENT ON THE FILE THEN         C
C         THE SPECIFIED ELEMENTS OF 'A' ARE FILLED WITH BLANKS.         C
C         CIN301 READS THE WORDS IN LOCATIONS L TO L+M-1 INTO A(1:M-1)  C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      PARAMETER (LRECL=512,LIND=100)
      CHARACTER*10 IXNAME(LIND),INDEX*(*),NAME1,A(*),X(LRECL)
      COMMON    /INDX30/ IXNMBR(LIND),IXLAST,IEOF,NREC1
      COMMON    /CHAR30/ X
      COMMON    /JNDX30/ IXNAME
      LL=1
      MM=N
      GOTO 5
      ENTRY CIN301 (A,L,M,INDEX)
      LL=L
      MM=L+M-1
    5 IF(INDEX.EQ.' ') RETURN
      NAME1=INDEX
      DO 10 I=1,IXLAST
   10 IF(NAME1.EQ.IXNAME(I)) GOTO 15
      DO 20 K=LL,MM
   20 A(K-LL+1)=' '
      IF(LL.EQ.1) PRINT *,'MATRIX ',INDEX,' NOT ON UNIT30.   '
     *                  ,' ARRAY HAS BEEN CLEARED'
      RETURN
   15 NREC=IXNMBR(I)+(LL-1)/LRECL
      I1=(NREC-IXNMBR(I))*LRECL+1
   40 I2=I1+LRECL-1
      READ (30,REC=NREC) X
      NREC1=NREC
      DO 50 J=MAX(I1,LL),MIN(I2,MM)
   50 A(J-LL+1)=X(J-I1+1)
      IF (I2.LT.MM) THEN
        I1=I1+LRECL
        NREC=NREC+1
        GO TO 40
      ENDIF
      RETURN
      END
      SUBROUTINE CLOS30(CF)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE CLOS30                                                C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      CHARACTER*(*) CF
C
      CLOSE (30,STATUS=CF)
      RETURN
      END
      SUBROUTINE COU30  (A,N,INDEX)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE COU30                                                  C
C        COU (OVER)WRITES A STRING  CONTAINING A(1:N) ON UNIT30.        C
C        THIS RECORD IS IDENTIFIED BY 'INDEX'                           C
C        IF INDEX.EQ.' ' COU AND COU1 PERFORM NO OPERATION.             C
C        COU301 (OVER)WRITES POSITIONS L TO L+M-1 OF THIS RECORD        C
C        IN COU301 N MUST BE SPECIFIED TO RESERVE SPACE FOR A           C
C        TOTAL OF N WORDS ON THE FILE. IF N IS TOO LARGE                C
C        TO FIT IN THE SPACE DEFINED BY PREVIOUS CALLS                  C
C        THE RECORD IS NOT OVERWRITTEN, BUT A NEW RECORD                C
C        IS CREATED AT THE END OF THE FILE. THE OLD                     C
C        INFORMATION IS THEN LOST.                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      PARAMETER (LRECL=512,LIND=100)
      CHARACTER*10 IXNAME(LIND),INDEX*(*),NAME1,A(N),X(LRECL)
      COMMON    /INDX30/ IXNMBR(LIND),IXLAST,IEOF,NREC1
      COMMON    /CHAR30/ X
      COMMON    /JNDX30/ IXNAME
      LL=1
      MM=N
      GOTO 5
      ENTRY COU301 (A,L,M,N,INDEX)
      LL=L
      MM=L+M-1
    5 IF(INDEX.EQ.' ') RETURN
      NAME1=INDEX
      NRECS=(N-1)/LRECL+1
      DO 10 I=1,IXLAST
   10 IF(NAME1.EQ.IXNAME(I)) GOTO 15
      IXLAST=I
   15 IF (IXNMBR(I+1)-IXNMBR(I).LT.NRECS.AND.I.NE.IXLAST) THEN
        DO 20 I=I,IXLAST+1
        IXNAME(I)=IXNAME(I+1)
   20   IXNMBR(I)=IXNMBR(I+1)
        I=IXLAST
      ENDIF
      NREC= IXNMBR(I)+(LL-1)/LRECL
      I1=(NREC-IXNMBR(I))*LRECL+1
   40 I2=I1+LRECL-1
      IF       (NREC.LE.IEOF
     *   .AND. (I1.LT.LL.OR.(I2.GT.MM.AND.MM.LT.N)))
     *  READ(30,REC=NREC) X
      DO 50 J=MAX(I1,LL),MIN(I2,MM)
   50 X(J-I1+1)=A(J-LL+1)
      WRITE(30,REC=NREC) X
      NREC1=NREC
      IF(I2.LT.MM) THEN
        I1=I1+LRECL
        NREC=NREC+1
        GOTO 40
      ENDIF
   60 IF (IXNMBR(I+1)-IXNMBR(I).LT.NRECS) THEN
        IXNAME(I)=NAME1
        IXNMBR(I+1)=IXNMBR(I)+NRECS
        IEOF=MAX(NREC1,IEOF)
        WRITE(30,REC=1) IXNAME,IXNMBR,IXLAST,IEOF,'SPRUITJES'
      ENDIF
      RETURN
      END
      SUBROUTINE IN30  (A,N,INDEX)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE IN30                                                  C
C         IN READS THE FIRST N WORDS OF THE RECORD, IDENTIFIED         C
C         BY 'INDEX', INTO A(1,N)                                      C
C         IF INDEX.EQ.' ' IN AND IN301 PERFORM NO OPERATION.           C
C         IF NO RECORD WITH 'INDEX' IS PRESENT ON THE FILE THEN        C
C         THE SPECIFIED ELEMENTS OF 'A' ARE FILLED WITH REAL ZERO.     C
C         IN301 READS THE WORDS IN LOCATIONS L TO L+M-1 INTO A(1:M-1)  C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      REAL A(*)
      PARAMETER (LRECL=512,LIND=100)
      CHARACTER *10 ,IXNAME(LIND),INDEX*(*),NAME1
      REAL X
      COMMON    /INDX30/ IXNMBR(LIND),IXLAST,IEOF,NREC1,X(LRECL)
      COMMON    /JNDX30/ IXNAME
      LL=1
      MM=N
      GOTO 5
C
      ENTRY IN301 (A,L,M,INDEX)
C
      LL=L
      MM=L+M-1
    5 IF(INDEX.EQ.' ') RETURN
      NAME1=INDEX
      DO 10 I=1,IXLAST
   10 IF(NAME1.EQ.IXNAME(I)) GOTO 15
      DO 20 K=LL,MM
   20 A(K-LL+1)=0
      IF(LL.EQ.1) PRINT *,'MATRIX ',INDEX,' NOT ON UNIT30.   '
     *                  ,' ARRAY HAS BEEN CLEARED'
      RETURN
   15 NREC=IXNMBR(I)+(LL-1)/LRECL
      I1=(NREC-IXNMBR(I))*LRECL+1
   40 I2=I1+LRECL-1
      READ (30,REC=NREC) X
      NREC1=NREC
      DO 50 J=MAX(I1,LL),MIN(I2,MM)
   50 A(J-LL+1)=X(J-I1+1)
      IF (I2.LT.MM) THEN
        I1=I1+LRECL
        NREC=NREC+1
        GO TO 40
      ENDIF
      RETURN
      END
      SUBROUTINE LIST30
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE LIST30                                                C
C     LISTS CONTENTS OF IXNAME                                         C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      PARAMETER (LRECL=512,LIND=100)
      CHARACTER *10 ,IXNAME(LIND)
      COMMON    /INDX30/ IXNMBR(LIND),IXLAST,IEOF,NREC1,X(LRECL)
      COMMON    /JNDX30/ IXNAME
      DO 10 I=1,LIND
      IXN=IXNMBR(I)
      IF (IXN.EQ.0) GOTO 10
      PRINT *,IXN,' ',IXNAME(I)
   10 CONTINUE
      PRINT *,'IEOF= ',IEOF,' IXLAST= ',IXLAST
      RETURN
      END
      SUBROUTINE OPEN30(LFN,NWFILE)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE OPEN30                                                C
C        OPEN30   INITIATES UNIT30 FOR USE WITH IN AND OUT.            C
C        ANY FILETYPE WILL BE ACCEPTED, BUT A FILE THAT HAS            C
C        NOT BEEN CREATED BY OPEN30 WILL BE EQUIVALENT TO AN           C
C        EMPTY FILE.                                                   C
C        ENTRY OPEN31 PERFORMS THE SAME FUNCTIONS, BUT DOES            C
C        NOT OPEN THE FILE. THE USER IS RESPONSIBLE FOR ASSO-          C
C        CIATING UNITNUMBER 30 WITH A FILENAME AND DECLARING           C
C        IT TO BE A FORTRAN DIRECT ACCESS FILE.                        C
C        IF THE FILE IS EMPTY, NWFILE IS SET TO .TRUE.                 C
C                                                                      C
C        THIS IS A STANDARDISED VERSION (I.E. NO INTRODUCTION OF       C
C        RECORD 'IDENT' AS IN PROGRAM BIGMOL)                          C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      SAVE
      PARAMETER (LRECL=512,LIND=100)
      LOGICAL NWFILE
      CHARACTER*10 IXNAME(LIND),PASSW*9,LFN*(*)
      COMMON /INDX30 / IXNMBR(LIND),IXLAST,IEOF,NREC1,X(LRECL)
      COMMON /JNDX30 / IXNAME
C
C-------- UNFORMATTED FILE ON VAX: RECL EXPRESSED IN LONGWORDS!
      OPEN(30,FILE=LFN,STATUS='UNKNOWN',ACCESS='DIRECT',
     +  FORM='UNFORMATTED',RECL=LRECL)
      ENTRY OPEN31(NWFILE)
      NWFILE=.FALSE.
      PASSW=' '
      READ(30,REC=1,ERR=200) IXNAME,IXNMBR,IXLAST,IEOF,PASSW
  200 IF (PASSW.NE.'SPRUITJES') THEN
        NWFILE=.TRUE.
        DO 10 I=1,LIND
        IXNAME(I)=' '
   10   IXNMBR(I)=0
        IXNMBR(1)=2
        IXLAST=0
        IEOF=0
        WRITE(30,REC=1)IXNAME,IXNMBR,IXLAST,IEOF,'SPRUITJES'
      ENDIF
      NREC1=0
      RETURN
      END
      SUBROUTINE OUT30  (A,N,INDEX)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE OUT30                                                 C
C        OUT (OVER)WRITES A RECORD  CONTAINING A(1:N) ON UNIT30.       C
C        THIS RECORD IS IDENTIFIED BY 'INDEX'                          C
C        IF INDEX.EQ.' ' OUT AND OUT1 PERFORM NO OPERATION.            C
C        OUT301 (OVER)WRITES POSITIONS L TO L+M-1 OF THIS RECORD       C
C        IN OUT301 N MUST BE SPECIFIED TO RESERVE SPACE FOR A          C
C        TOTAL OF N WORDS ON THE FILE. IF N IS TOO LARGE               C
C        TO FIT IN THE SPACE DEFINED BY PREVIOUS CALLS                 C
C        THE RECORD IS NOT OVERWRITTEN, BUT A NEW RECORD               C
C        IS CREATED AT THE END OF THE FILE. THE OLD                    C
C        INFORMATION IS THEN LOST.                                     C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      REAL A(*)
      PARAMETER (LRECL=512,LIND=100)
      CHARACTER *10 ,IXNAME(LIND),INDEX*(*),NAME1
      REAL X
      COMMON    /INDX30/ IXNMBR(LIND),IXLAST,IEOF,NREC1,X(LRECL)
      COMMON    /JNDX30/ IXNAME
      LL=1
      MM=N
      GOTO 5
C
      ENTRY OUT301 (A,L,M,N,INDEX)
C
      LL=L
      MM=L+M-1
    5 IF(INDEX.EQ.' ') RETURN
      NAME1=INDEX
      NRECS=(N-1)/LRECL+1
      DO 10 I=1,IXLAST
   10 IF(NAME1.EQ.IXNAME(I)) GOTO 15
      IXLAST=I
   15 IF (IXNMBR(I+1)-IXNMBR(I).LT.NRECS.AND.I.NE.IXLAST) THEN
        DO 20 I=I,IXLAST+1
        IXNAME(I)=IXNAME(I+1)
   20   IXNMBR(I)=IXNMBR(I+1)
        I=IXLAST
      ENDIF
      NREC= IXNMBR(I)+(LL-1)/LRECL
      I1=(NREC-IXNMBR(I))*LRECL+1
   40 I2=I1+LRECL-1
      IF       (NREC.LE.IEOF
     *   .AND. (I1.LT.LL.OR.(I2.GT.MM.AND.MM.LT.N)))
     *  READ(30,REC=NREC) X
      DO 50 J=MAX(I1,LL),MIN(I2,MM)
   50 X(J-I1+1)=A(J-LL+1)
      WRITE(30,REC=NREC) X
      NREC1=NREC
      IF(I2.LT.MM) THEN
        I1=I1+LRECL
        NREC=NREC+1
        GOTO 40
      ENDIF
   60 IF (IXNMBR(I+1)-IXNMBR(I).LT.NRECS) THEN
        IXNAME(I)=NAME1
        IXNMBR(I+1)=IXNMBR(I)+NRECS
        IEOF=MAX(NREC1,IEOF)
        WRITE(30,REC=1) IXNAME,IXNMBR,IXLAST,IEOF,'SPRUITJES'
      ENDIF
      RETURN
      END
      SUBROUTINE RCIN30(FOUND,RINDEX)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C     SUBROUTINE RCIN30                                                C
C         CHECKS WHETHER RECORD 'INDEX' IS PRESENT                     C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
      LOGICAL FOUND
      CHARACTER*(*) RINDEX
      PARAMETER (LRECL=512,LIND=100)
      CHARACTER *10 ,IXNAME(LIND)
      COMMON    /INDX30/ IXNMBR(LIND),IXLAST,IEOF,NREC1,X(LRECL)
      COMMON    /JNDX30/ IXNAME
      DO 10 I=1,LIND
      IXN=IXNMBR(I)
      IF(IXN.EQ.0.OR.IXNAME(I).EQ.' ') GOTO 10
      IF (IXNAME(I).EQ.RINDEX) THEN
        FOUND=.TRUE.
        RETURN
      ENDIF
   10 CONTINUE
      FOUND=.FALSE.
      RETURN
      END
      SUBROUTINE OPENWA(KFILE,LFN,NWFILE)
      CHARACTER*(*) LFN
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL OPEN30(LFN,NWFILE)
      RETURN
      END
      SUBROUTINE CLOSWA(KFILE,CF)
      CHARACTER*(*) CF
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL CLOS30(CF)
      RETURN
      END
      SUBROUTINE INWA(KFILE,A,N,INDEX)
      CHARACTER*(*) INDEX
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL IN30(A,N,INDEX)
      RETURN
      END
      SUBROUTINE OUTWA(KFILE,A,N,INDEX)
      CHARACTER*(*) INDEX
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL OUT30(A,N,INDEX)
      RETURN
      END
      SUBROUTINE INWA1(KFILE,A,L,M,INDEX)
      CHARACTER*(*) INDEX
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL IN301(A,L,M,INDEX)
      RETURN
      END
      SUBROUTINE OUTWA1(KFILE,A,L,M,N,INDEX)
      CHARACTER*(*) INDEX
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL OUT301(A,L,M,N,INDEX)
      RETURN
      END
      SUBROUTINE CINWA(KFILE,A,N,INDEX)
      CHARACTER*(*) A(*),INDEX
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL CIN30(A,N,INDEX)
      RETURN
      END
      SUBROUTINE COUWA(KFILE,A,N,INDEX)
      CHARACTER*(*) A(*),INDEX
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL COU30(A,N,INDEX)
      RETURN
      END
      SUBROUTINE CINWA1(KFILE,A,L,M,INDEX)
      CHARACTER*(*) A(*),INDEX
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL CIN301(A,L,M,INDEX)
      RETURN
      END
      SUBROUTINE COUWA1(KFILE,A,L,M,N,INDEX)
      CHARACTER*(*) A(*),INDEX
      IF (KFILE.NE.1) STOP 'WA: KFILE NOT 1'
      CALL COU301(A,L,M,N,INDEX)
      RETURN
      END
